Developer CD Series 2000 August: Tool Chest/Dev.CD Aug 00 TC Disk 2.toast/pc/sample code/overview/moreisbetter/mib-libraries/moredevices/traddriverloaderlib/testtraddriverloaderlib/testtraddriverloader.p

Text File | 2000-06-23 | 7.0 KB | 264 lines

(*
    File:        TestTradDriverLoaderLib.p

    Contains:    Pascal program to test TradDriverLoaderLib.

    Written by:    Quinn

    Copyright:    © 1996-1999 by Apple Computer, Inc., all rights reserved.

                You may incorporate this Apple sample source code into your program(s) without
                restriction. This Apple sample source code has been provided "AS IS" and the
                responsibility for its operation is yours. You are not permitted to redistribute
                this Apple sample source code as "Apple sample source code" after having made
                changes. If you're going to re-distribute the source, we require that you make
                it clear in the source that the code was descended from Apple sample source
                code, but that you've made changes.

    Change History (most recent first):

         <1>     25/2/99    Quinn   First checked in.
*)

program TestTradDriverLoaderLib;

    uses

        // MoreIsBetter Setup

        MoreSetup,

        // Mac OS Interfaces

        MacTypes,
        LowMem,
        Files,
        Devices,

        // MIB Prototypes

        TradDriverLoaderLib;

    procedure CheckTestResult(err : OSErr; mesg : Str255);
    begin
        if err = noErr then begin
            writeln('  Passed ', mesg, '.');
        end else begin
            writeln('  •••Failed ', mesg, ' with error ', err:1, '.');
        end; (* if *)
    end; (* CheckTestResult *)

    procedure CheckTestResultBool(b : Boolean; mesg : Str255);
    begin
        if b then begin
            writeln('  Passed ', mesg, '.');
        end else begin
            writeln('  •••Failed ', mesg, '.');
        end; (* if *)
    end; (* CheckTestResultBool *)

    procedure TestTradHighestUnitNumber;
    begin
        writeln('TestTradHighestUnitNumber');
        writeln;
        CheckTestResultBool( TradHighestUnitNumber = (LMGetUnitTableEntryCount - 1) , 'check against LMGetUnitTableEntryCount');
    end; (* TestTradHighestUnitNumber *)

    procedure TestInstallOpenRemove;
        var
            err : OSErr;
            rsrcName : Str255;
            refNum : DriverRefNum;
            cpb : CntrlParam;
    begin
        writeln('TestInstallOpenRemove');
        writeln;

        (* Install *)
        rsrcName := '.Test';
        err := TradInstallDriverFromResource(0, @rsrcName, 48, TradHighestUnitNumber() + 1, refNum);
        CheckTestResult(err, 'install');

        (* Open *)
        if err = noErr then begin
            err := TradOpenInstalledDriver(refNum, fsRdWrPerm);
            CheckTestResult(err, 'open');
        end; (* if *)

        (* Functional *)
        if err = noErr then begin
            cpb.ioCRefNum := refNum;
            cpb.csCode := 666;
            err := PBStatusSync(@cpb);
            CheckTestResult(err, 'status call');
        end; (* if *)
        if err = noErr then begin
            CheckTestResultBool(cpb.csParam[0] = refNum, 'results from status call');
        end; (* if *)

        (* Remove *)
        if err = noErr then begin
            err := TradRemoveDriver(refNum, false);
            CheckTestResult(err, 'remove');
        end; (* if *)

        writeln;
    end; (* TestInstallOpenRemove *)

    procedure TestGestaltCalls;
        var
            rsrcName : Str255;
            err : OSErr;
            refNum : DriverRefNum;
            flags : DriverFlags;
    begin
        writeln('TestGestaltCalls');
        writeln;

        (* Install *)
        rsrcName := '.Test';
        err := TradInstallDriverFromResource(0, @rsrcName, 48, TradHighestUnitNumber() + 1, refNum);
        CheckTestResult(err, 'install');

        (* Open *)
        if err = noErr then begin
            err := TradOpenInstalledDriver(refNum, fsRdWrPerm);
            CheckTestResult(err, 'open');
        end; (* if *)

        (* Gestalt On *)
        if err = noErr then begin
            err := TradDriverGestaltOn(refNum);
            CheckTestResult(err, 'set Gestalt on');
        end; (* if *)
        if err = noErr then begin
            err := TradGetDriverInformation(refNum, nil, @flags, nil, nil);
            CheckTestResultBool((err = noErr) & TradDriverGestaltIsOn(flags), 'confirm Gestalt on');
        end; (* if *)

        (* Gestalt Off *)
        if err = noErr then begin
            err := TradDriverGestaltOff(refNum);
            CheckTestResult(err, 'set Gestalt off');
        end; (* if *)
        if err = noErr then begin
            err := TradGetDriverInformation(refNum, nil, @flags, nil, nil);
            CheckTestResultBool((err = noErr) & not TradDriverGestaltIsOn(flags), 'confirm Gestalt off');
        end; (* if *)

        (* Remove *)
        if err = noErr then begin
            err := TradRemoveDriver(refNum, false);
            CheckTestResult(err, 'remove');
        end; (* if *)

        writeln;
    end; (* TestGestaltCalls *)


    procedure TestInfoCalls;
        var
            err : OSErr;
            refNumsCount : ItemCount;
            i : ItemCount;
            refNums : packed array [0..999] of DriverRefNum;
            thisUnit : UnitNumber;
            flags : DriverFlags;
            name : Str255;
            driverHeader : DRVRHeaderPtr;
    begin
        writeln('TestInfoCalls');
        writeln;

        refNumsCount := 1000;
        err := TradLookupDrivers(0, TradHighestUnitNumber, false, refNumsCount, @refNums[0]);
        CheckTestResult(err, 'lookup drivers');
        if err = noErr then begin
            for i := 0 to refNumsCount - 1 do begin
                err := TradGetDriverInformation(refNums[i], @thisUnit, @flags, @name, @driverHeader);
                if err = noErr then begin
                    writeln('  refNum=', refNums[i]:1, ', unit=', thisUnit:1, ', flags=', (ord4(flags)),
                                    ', name=“', name, '”, addr=', ord4(driverHeader));
                end else begin
                    writeln('  •••Error ', err:1, ' getting info for refnum ', refNums[i]:1, '.');
                end; (* if *)
            end; (* for *)
        end; (* if *)

        writeln;
    end; (* TestInfoCalls *)

    procedure TestAddLots;
        var
            err : OSErr;
            refNum : DriverRefNum;
            highChar : char;
            lowChar : char;
            rsrcName : Str255;
    begin
        writeln('TestAddLots');
        writeln;

        (* Add 2 * 26 = 52) drivers to the unit table and open them all!
                Have to stop before 'T' otherwise our unique names clash with '.Test'.
                Note that this is limited by kMaximumNumberOfUnitTableEntries defined
                in TradDriverLoaderLib.c.
        *)

        for highChar := 'A' to 'B' do begin
            for lowChar := 'A' to 'Z' do begin
                rsrcName := '.Test';
                err := TradInstallDriverFromResource(0, @rsrcName, 48, TradHighestUnitNumber() + 1, refNum);
                if err = noErr then begin
                    rsrcName[2] := highChar;
                    rsrcName[3] := lowChar;
                    err := TradRenameDriver(refNum, rsrcName);
                end; (* if *)
                if err = noErr then begin
                    err := TradOpenInstalledDriver(refNum, fsRdWrPerm);
                end; (* if *)
                if err <> noErr then begin
                    writeln('  •••Adding lots failed at ''', highChar, lowChar, ''' with error ', err:1, '.');
                    exit(TestAddLots);
                end; (* if *)
            end; (* for *)
        end; (* for *)

        writeln('  Drivers added successfully!');

        (* Remove all of the added units. *)

        for highChar := 'A' to 'B' do begin
            for lowChar := 'A' to 'Z' do begin
                rsrcName := '.Test';
                rsrcName[2] := highChar;
                rsrcName[3] := lowChar;
                err := OpenDriver(rsrcName, refNum);
                if err = noErr then begin
                    err := TradRemoveDriver(refNum, false);
                end; (* if *)
                if err <> noErr then begin
                    writeln('  •••Removing lots failed at ''', highChar, lowChar, ''' with error ', err:1, '.');
                    exit(TestAddLots);
                end; (* if *)
            end; (* for *)
        end; (* for *)

        writeln('  Drivers removed successfully!');

        writeln;
    end; (* TestAddLots *)

begin
    writeln('Hello Cruel World!');
    writeln;
    writeln('TestTradDriverLoaderLib');
    writeln('-- a test tool for the TradDriverLoaderLib library.');
    writeln;
    TestInstallOpenRemove;
    TestGestaltCalls;
    TestInfoCalls;
    TestAddLots;
    writeln('Done.  Press command-Q to Quit.');
end. (* TestTradDriverLoaderLib *)